subroutine bmpts(n1,n2,m)
c n1,n2 point to start and end of this beam (ntptr array)
c jtail holds how many tails on each note in beam area
        dimension rjq(15)
        common /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100)
     1 ,jstdir(150),ntptr(150) /rjq/r1,r2,r3,r4,r5,r6,r7,r8,r9,
     1 r10,r11,r12,r13,r14,r15
        equivalence (rjq(1),r1)

c use rpos and posnt areas??? for jbmnt(m), jtail(m)
C  *******  1ST MAIN LOOP *********
500     J=0
511     J=J+1
        A=V(J)
        call stupdn(jstm1,n1,r8,a,np1,hgt1,igr1)
c 1st note: jstm1=stem dir, n=note num, r8=num over beam, a=note num
c hgtn=height of note at each end of beam -- consider chords too
c find heights of notes in between later.  igr<>0 = grace note.
        JMP=1
        JDIF=0
505     L=0
        K=0
        C=0.
        POS=-10.
        IT=0
        UPDN=0
C  UPDN=NEG.=STEMS DOWN, POS.=STEMS UP
        JA=J+1
        B=V(JA)
        call stupdn(jstm2,n2,rnum2,b,np2,hgt2,igr2)
c 2nd note: jstm2=stem dir, nn=note num, r9=num over beam, b=note num
c /3 5.3/  .3 causes number 3 to appear over beam
        if(n2.le.n1)n2=n1+1
c /12 0/ or /12 12/ etc. will produce /12 13/
        UPDN=B
        if(gr1.eq.gr2)go to 5030
        write(*,'('' **** grace note beam mismatch **** '',2i3)')n1,n2
        go to 5032
5030    IF(N1.GT.0.AND.N2.LT.JNTC)GO TO 503
5031    FORMAT(' **** WRONG BEAM NUMBER?  ',2I3)  
        WRITE(*,5031)N1,N2
5032    pause
        return
 
503     r3=r(3,np1)
        r6=r(3,np2)
        if(rnum2.ne.0.)r8=rnum2
c r3=pos of left side of beam, r6=pos of right side, r8=num on beam
        r1=6.
        r2=staff

        umax=hgt1
        dmax=hgt2
c which end is highest? - lowest?
        if(hgt2.gt.umax)call exch(umax,dmax)

        num=0
        do 601 k=n1,n2
        num=num+1
        l=ntptr(k)
        jtail(num)=amod(r(9,l),10.)
601     jbmnt(num)=l
c jtail=list of tails, jbmnt=points to specific note

c any notes between?
        do 60 k=9,15
60      rjq(k)=0.
c zero higher params

        if(np2-np1.eq.1)go to 504
c next find smallest num of tails (l)
        mm=0
        l=jtail(1)
        do 61 k=2,num
        kk=jtail(k)
        if(kk.ne.l)mm=1
c mm=flag for varying tails
61      if(kk.lt.l)l=kk
        if(mm.eq.0)go to 504
c jump if all same tails

        jr=10
c jr points to start of added beam params (10-12, 13-15)
        mm=1
63      if(jtail(mm).ne.l)go to 62
c find needed extra beams
        if(mm.eq.num)go to 62
        mm=mm+1
        go to 63
62      if(mm.eq.1)go to 63
c now 1st note has full beam only
        jt=jtail(mm)
        nn=mm
c how many notes with same tails?
64      nn=nn+1
        if(nn.gt.num)go to 65
        if(jtail(nn).eq.jt)go to 64
65      if(nn-mm.eq.1)go to 66
c jump if only 1 note with this many tails
        rjq(jr+1)=r(3,jbmnt(mm))
        rjq(jr+2)=r(3,jbmnt(nn-1))
c set lft-rt of added beam
        go to 67


67      rjq(jr)=jt*10+l-jt
c r10 and r13 are 2-digit nums (xy).  x=num of tails, y=displacement
        if(nn.ge.num)go to 70
c jump if all done with this beam area
        jr=13
c prepare for possible 2nd composite
        go to ?????


        nx=np1
505     nx=nx+1
        if(r(1,nx).ne.1.)go to 506
c is next a note?  (beams can go over rests, clefs, etc.)
        if(igr1.eq.0)go to 507
c skip if not looking for grace note
        x=amod(r(4,nx),100.)


507
506     if(nx.lt.np2)go to 505



504     r7=jstm+jtail(1)
c add here re. 6*2 beams -- make it (3+3)*2 as default
5001    iz=iz+1
        do 5002 k=1,15
5002    r(k,iz)=rjq(k)

5000    j=j+2
        if(j.lt.kv)go to 511
c go back for more beams








                                                                        RB=0.
        GO TO 550
504     RB=2.
        IF(NN.LT.0)RB=-RB
C STEM DIRECT. IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
550     RN(JA+IS)=POS
        B=ZNOTE(K)
C ZNOTE GETS HEIGHT AND CHECKS FOR NOTE ON OTHER STAFF/STEM DIR.

513     RN(JB+